Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/source/demostu2/gouraud1.pas

Pascal/Delphi Source File | 1994-10-28 | 9.6 KB | 598 lines

PROGRAM gouraud1;
{
    Gouraud shading or what?
    - by Bjarke Viksφe
    sep 1994
    "Shade HLine from Color1 to Color2" routine by The Faker/S!P
    Please remember to credit him for this if you use it for anything.
    I'm sure he's put a lot of effort in to get things that fast and neat.

    And it does look pretty strange with the low resolution. I'll try
    to make another version with 1 pixel resolution.
}

{{$DEFINE DEBUG}

USES
    DEMOINIT;

CONST
    NUMBER_FACES = 6;
    NUMBER_COORDS = 8;
    BOX = 140; {size of box}

TYPE
    SlopeType = array[0..200*2] of integer;

    FaceType = RECORD
        l1,l2,l3,l4 : byte;
    end;


VAR
    slope,zslope : SlopeType;
    face : array[1..NUMBER_FACES] of FaceType;
    cbuffer : array[0..NUMBER_COORDS*4-1] of integer;

    LineTable1 : array[0..319] of byte;
    LineTable2 : array[0..319] of byte;

    miny,maxy, scrminy,scrmaxy : integer;
    lastscrminy,lastscrmaxy : integer;

    sinustabel : array[0..639] of integer;
    v1,v2,v3 : word;
    cos1,sin1,cos2,sin2,cos3,sin3 : integer;


CONST
    display1 : word = $0000;
    display2 : word = $4000;
    {setup coords for a box}
    coords : array[0..NUMBER_COORDS*3-1] of integer =
        (box,box,-box, -box,box,-box, -box,-box,-box, box,-box,-box,
        box,box,box, -box,box,box, -box,-box,box, box,-box,box);


(*------------------------------------------------*)

procedure SetupSinus;
var
    i : integer;
    v, vadd : real;
begin
    v:=0.0;
    vadd:=(2.0*pi/512.0);
    for i:=0 to 639 do begin
        sinustabel[i]:=round(sin(v)*32767);
        v:=v+vadd;
    end;
end;

procedure SetupFaces;
{setup faces. Make sure face keeps track of which coordinates it uses!}
begin
    with face[1] do begin l1:=3; l2:=2; l3:=1; l4:=0; end;
    with face[2] do begin l1:=4; l2:=5; l3:=6; l4:=7; end;
    with face[3] do begin l1:=0; l2:=1; l3:=5; l4:=4; end;
    with face[4] do begin l1:=1; l2:=2; l3:=6; l4:=5; end;
    with face[5] do begin l1:=2; l2:=3; l3:=7; l4:=6; end;
    with face[6] do begin l1:=3; l2:=0; l3:=4; l4:=7; end;
end;

procedure InitDemo;
var
    i : integer;
begin
    Screen_Off;
    ClearWholeScreen;
    SetupSinus;
    SetupFaces;

    scrminy := 0; scrmaxy := 200;
    lastscrminy := 0; lastscrmaxy := 200;
    v1:=0; v2:=0; v3:=0;

    for i:=1 to 63 do SetRGB(i,0,64-i,0);
    for i:=64 to 255 do SetRGB(i,0,0,0);

    for i:=0 to 319 do begin
        LineTable1[i]:=(15 SHL (i AND 3)) AND 15;
        LineTable2[i]:=(2 SHL (i AND 3))-1;
    end;

    Screen_On;
end;


(*------------------------------------------------*)

procedure SwapDisplay;
var
    temp : word;
begin
    temp:=display2;
    display2:=display1;
    display1:=temp;
    SetAddress(Ptr(SEGA000,display2));
end;

procedure ClearScreen(y1,y2 : integer); assembler;
asm
    mov    dx,$3C4
    mov    ax,$0F02
    out    dx,ax

    mov    bx,y1        {clear box around vector - only y-coords are actually}
    mov    dx,y2        {used for calculation... x-coords are constant 192 pixels}
    sub    dx,bx
    cmp    dx,200
    ja        @done

    lea    si,ytabel
    add    bx,bx
    mov    di,[si+bx]
    add    di,display1
    add    di,16

    mov    es,SEGA000
    DB LONG; xor ax,ax
    mov    bx,48/4
@loop:
    mov    cx,bx
    rep; DB LONG; stosw
    add    di,WIDTH-48
    dec    dl
    jnz    @loop
@done:
end;


(*------------------------------------------------*)

procedure ClearSlope; assembler;
asm
    mov    ax,ds
    mov    es,ax
    lea    di,slope
    DB LONG; mov ax,$8000; DW $8000;
    cld
    mov    cx,TYPE(slopetype)/4
    rep; DB LONG; stosw
end;

procedure CalcSlope(l1,l2 : integer); assembler;
var
    z1,z2,coladd : word;
    xlowadd : word;
    ysize : integer;
asm
    lea    si,cbuffer
    DB LONG; xor cx,cx
    mov    bx,l1                    {get first coords}
    shl    bx,3
    mov    ax,[si+bx+4]        {get z value}
    shr    ax,2
    mov    z2,ax
    mov    dx,[si+bx]            {get x/y coords}
    mov    cx,[si+bx+2]

    mov    ax,l2                    {get second coords}
    shl    ax,3
    add    si,ax
    mov    ax,[si+4]            {get z value}
    shr    ax,2
    mov    z1,ax
    mov    ax,[si]                {get x/y coords}
    mov    bx,[si+2]

    cmp    bx,cx                    {make sure we go downwards...}
    jle    @noswap
    mov    si,z1                    {swap z}
    xchg    z2,si
    mov    z1,si
    xchg    ax,dx                    {swap x}
    xchg    bx,cx                    {sway y}
@noswap:

    cmp    bx,miny                {record miny and maxy}
    jae    @miny
    mov    miny,bx
@miny:
    cmp    cx,maxy
    jbe    @maxy
    mov    maxy,cx
@maxy:

    sub    cx,bx
    jcxz    @zero
    mov    ysize,cx
    add    bx,bx
    add    bx,bx
    lea    si,slope
    add    si,bx

    push    ax
    sub    dx,ax
    inc    dx

    mov    ax,dx
    DB LONG; shl    ax,16
    {cdq} DB $66,$99
    DB LONG; idiv    cx
    DB LONG; mov    dx,ax
    DB LONG; shr    dx,16
    mov    xlowadd,ax
    {DX also loaded... but kept alive}

    push    dx                        {also calc z-slope}
    mov    ah,BYTE PTR z2
    sub    ah,BYTE PTR z1
    xor    al,al
    cwd
    idiv    cx
    mov    coladd,ax
    pop    dx
@one:
    pop    cx

    xor    bx,bx
    mov    ah,BYTE PTR z1    {prepare also z-slope calc. z1:=z1*256}
    xor    al,al
    mov    di,$8000
@loop:
    cmp    [si],di
    jne    @other
    mov    [si+TYPE(SlopeType)],ah
    mov    [si],cx
    add    si,4
    add    bx,xlowadd
    adc    cx,dx
    add    ax,coladd
    dec    ysize
    jnz    @loop
    jmp    NEAR PTR @zero
@other:
    mov    [si+TYPE(SlopeType)+2],ah
    mov    [si+2],cx
    add    si,4
    add    bx,xlowadd
    adc    cx,dx
    add    ax,coladd
    dec    ysize
    jnz    @loop
@zero:
end;


(*------------------------------------------------*)

procedure CalcAngle;
begin
    sin1:=sinustabel[v1]; cos1:=sinustabel[v1+128];
    sin2:=sinustabel[v2]; cos2:=sinustabel[v2+128];
    sin3:=sinustabel[v3]; cos3:=sinustabel[v3+128];
    v1:=(v1+2) AND 511;
    v2:=(v2-1) AND 511;
    v3:=(v3+1) AND 511;
end;

procedure RotateAllCoords; assembler;
{Rotate all coords in "coords" around all 3 axis and make
 perspective calcualtion. Store x,y,z results in "cbuffer"}
var
    xkoord,ykoord,zkoord, n : integer;
asm
    mov    ax,ds
    mov    es,ax
    lea    si,coords
    lea    di,cbuffer
    mov    n,NUMBER_COORDS
    cld
@loop:
    lodsw
    mov    xkoord,ax
    lodsw
    mov    ykoord,ax
    lodsw
    mov    zkoord,ax

    mov    ax,xkoord               {rotate around Z-axis}
    push    ax
    imul    Cos1
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,ykoord
    imul    Sin1
    add    ax,ax
    adc    dx,dx
    sub    bx,dx
    mov    xkoord,bx
    pop    ax
    imul    Sin1
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,ykoord
    imul    Cos1
    add    ax,ax
    adc    dx,dx
    add    bx,dx
    mov    ykoord,bx

    mov    ax,ykoord               {rotate around Y-axis}
    push    ax
    imul    Cos2
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,zkoord
    imul    Sin2
    add    ax,ax
    adc    dx,dx
    sub    bx,dx
    mov    ykoord,bx
    pop    ax
    imul    Sin2
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,zkoord
    imul    Cos2
    add    ax,ax
    adc    dx,dx
    add    bx,dx
    mov    zkoord,bx

    mov    ax,xkoord               {rotate around X-axis}
    push    ax
    imul    Cos3
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,zkoord
    imul    Sin3
    add    ax,ax
    adc    dx,dx
    sub   bx,dx
    mov    xkoord,bx
    pop    ax
    imul    Sin3
    add    ax,ax
    adc    dx,dx
    mov    bx,dx
    mov    ax,zkoord
    imul    Cos3
    add    ax,ax
    adc    dx,dx
    add    bx,dx
    mov    zkoord,bx

    add    bx,800
    and    bx,bx
    jnz    @zero
    mov    bl,1
@zero:

    mov    ax,xkoord
    cwd
    mov    dl,ah
    mov    ah,al
    xor    al,al
    idiv    bx
    add    ax,160
    stosw

    mov    ax,ykoord
    cwd
    mov    dl,ah
    mov    ah,al
    xor    al,al
    idiv    bx
    add    ax,100
    stosw

    mov    ax,bx
    sub    ax,390
    stosw
    add    di,2

    dec    n
    jnz    @loop
end;



function FaceShown(l1,l2,l3 : byte) : boolean;
var
    a,b : longint;
begin
    a := longmul(cbuffer[l1]-cbuffer[l2],cbuffer[l3+1]-cbuffer[l2+1]);
    b := longmul(cbuffer[l1+1]-cbuffer[l2+1],cbuffer[l3]-cbuffer[l2]);
    FaceShown := (a-b) > 0;
end;


procedure FillShape(y,ysize : integer); assembler;
var
    c1,c2 : byte;
asm
    cmp    ysize,200
    jae    @done
    mov    ax,y
    add    ax,ax
    mov    si,ax
    mov    di,[si+OFFSET ytabel]
    add    di,display1
    lea    si,slope
    add    ax,ax
    add    si,ax

    mov    es,SEGA000
    mov    dx,$3C4
    mov    al,$02
    out    dx,al
    cld
@yloop:
    mov    bh,[si+TYPE(slopetype)] {fetch z value}
    lodsw                                    {fetch first xpos}
    mov    dx,ax
    mov    bl,[si+TYPE(slopetype)] {fetch second z value}
    lodsw                                    {fetch second xpos}
    cmp    ax,dx
    jle    @exchange
    xchg    ax,dx
    xchg    bl,bh
@exchange:
    mov    c1,bl
    mov    c2,bh

    cmp    dx,0
    jl        @filledout_fast
    cmp    ax,320
    jge    @filledout_fast
    cmp    ax,0
    jge    @cut1
    xor    ax,ax
@cut1:
    cmp    dx,319
    jle    @cut2
    mov    dx,319
@cut2:
    push    si
    push    di
    mov    bx,ax
    mov    si,dx
    mov    dx,$3C5

{the next lines are ripped from THE FAKER/S!P shade example}
    mov    al,[bx+OFFSET LineTable1]
    mov    ah,[si+OFFSET LineTable2]
    shr    bx,2
    shr    si,2
    mov    cx,si
    sub    cx,bx
    jcxz    @1
    dec    cx
    add    di,bx
    mov    bh,ah
    out    dx,al
    mov    al,c1
    shr    al,1
    stosb
    jcxz    @4
    mov    al,$0F
    out    dx,al
    push    bx
    xor    dx,dx
    xor    al,al
    mov    ah,c2
    sub    ah,c1
    sbb    dx,0
    idiv    cx
    mov    si,ax

    mov    dh,c1
    xor    dl,dl
    shr    cx,1
    jnc    @2
    add    dx,si
    mov    ax,dx
    shr    ax,9
    stosb
    jcxz    @5

@2:
    add    dx,si
    mov    bx,dx
    shr    bx,1
    add    dx,si
    mov    ax,dx
    shr    ax,1
    mov    al,bh
    stosw
    loop    @2

@5: pop    bx

@4:
    mov al,bh
    mov dx,3c5h
    out dx,al
    mov al,c2
    shr al,1
    stosb
    jmp @3

@1:
    add    di,bx
    and    al,ah
    out    dx,al
    mov    al,c1
    add    al,c2
    rcr    al,1
    shr    al,1
    stosb

@3:

@filledout:
    pop    di
    pop    si
@filledout_fast:
    add    di,WIDTH
    dec    ysize
    jnz    @yloop
@done:
end;


procedure RunOnce;
var
    i : integer;
begin
    SwapDisplay;
    VBLANK;
{$IFDEF DEBUG}
    SetRGB(0,30,0,0);
{$ENDIF}

    ClearScreen(lastscrminy,lastscrmaxy);

    lastscrminy := scrminy; lastscrmaxy := scrmaxy;
    scrminy := 200; scrmaxy := 0;

    CalcAngle;
    RotateAllCoords;

    for i:=1 to NUMBER_FACES do begin
        with face[i] do if FaceShown(l1 SHL 2,l2 SHL 2,l3 SHL 2) then begin
            ClearSlope;
            miny := 200; maxy := 0;
            CalcSlope(l1,l2);
            CalcSlope(l2,l3);
            CalcSlope(l3,l4);
            CalcSlope(l4,l1);
            FillShape(miny, maxy-miny);
            if (miny < scrminy) then scrminy := miny;
            if (maxy > scrmaxy) then scrmaxy := maxy;
        end;
    end;

{$IFDEF DEBUG}
    SetRGB(0,0,0,0);
    while KeyHit[26] do ; {Hit 'P' to pause}
{$ENDIF}
end;


begin
    OpenScreen;
    InitDemo;
    SetAllInterrupts;
    repeat RunOnce until Key='e';
    RestoreAllInterrupts;
    CloseScreen;
end.